perm filename IO.FAI[XGP,BGB]1 blob
sn#043289 filedate 1973-05-19 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00020 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 NSUBR(GETFIL)GET FILE SPEC FROM TTY LINE
C00006 00003 SUBR(TVDSKI) INPUT TV PICTURE FROM DISK FILE.
C00009 00004 SUBR(TVPACK). PACK TVBUF WITH PICTURE FROM SKY ARRAY.
C00011 00005 SUBR(TVDSKO) INPUT TV PICTURE FROM A DISK FILE.
C00013 00006 SUBR(PLOTO)-------------------------------------------------------
C00014 00007 SUBR(TVXGP)-------------------------------------------------------
C00017 00008 -----TVXGP - HALF TONE TABLE.
C00019 00009 SUBR(CREOUT)------------------------------------------------------
C00021 00010 SUBR(CREIN)-------------------------------------------------------
C00023 00011 SUBR(FONTI)-------------------------------------------------------
C00025 00012 SUBR(FONTO)-------------------------------------------------------
C00028 00013 SUBR(RELLOC)BASE--------------------------------------------------
C00030 00014 SUBR(TVIN4)------------------------------------------------------
C00032 00015 SUBR(TVIN6)------------------------------------------------------
C00035 00016 SUBR(TVCAMI)------------------------------------------------------
C00038 00017 SUBR(CAMERA)------------------------------------------------------
C00039 00018 NSUBR NEWIN
C00042 00019 NSUBR NEWOUT
C00046 00020 TAIL
C00047 ENDMK
C⊗;
NSUBR(GETFIL)GET FILE SPEC FROM TTY LINE
SETZM FILNAM↔SETZM EXTION
SETZM EXTION+1↔SETZM PPPN
MOVE 4,[POINT 6,FILNAM,-1]↔MOVEI 2,6
INCHWL 1↔CAIN 1,15↔GO[INCHWL↔POP2J]↔AOS(P)
JRST L+1
L: INCHWL 1
CAILE 1,"z"↔POP2J
CAIL 1,"a"↔SUBI 1,40 ;CONVERT LOWER CASE
CAIN 1,"."↔GO[MOVE 4,[POINT 6,EXTION,-1]↔MOVEI 2,3↔GO L]
CAIN 1,"["↔GO[MOVE 4,[POINT 6,PPPN,-1] ↔MOVEI 2,3↔GO L]
CAIN 1,","↔GO[HLRZ PPPN
PUSHJ P,[PPJUST: JUMPE [OUTSTR[ASCIZ/BAD P,PN/]
CLRBFI↔SOS -1(P)↔CRLF↔POP3J]
TRNE 77↔POP0J↔LSH -6↔GO PPJUST]
HRLM PPPN↔MOVE 4,[POINT 6,PPPN,17]↔MOVEI 2,3↔GO L]
CAIN 1,"]"↔GO[HRRZ PPPN↔CALL(PPJUST)
HRRM PPPN↔INCHWL 1↔GO FINQ]
FINQ: CAIN 1,15↔GO EOL ;END OF THE LINE.
CAIN 1,12↔POP2J
; CAIN 1,"→"↔POP2J
CAIG 1," "↔GO L ;IGNORE GARBAGE.
SOJL 2,L↔SUBI 1,40↔IDPB 1,4↔GO L
EOL: INCHWL 2
SKIPN 2,EXTION↔MOVE 2,ARG2↔MOVEM 2,EXTION
SKIPN FLGBGB↔POP2J
;BGB'S DEFAULT PROJECT SPECIFICATION.
SKIPE 2,PPPN↔POP2J
MOVE 2,ARG1↔MOVEM 2,PPPN
SETZ 2,↔DSKPPN 2,
HRRM 2,PPPN
POP2J
BEND;12/10/72------------------------------------------------------
INTERNAL FILNAM,EXTION,PPPN
FILNAM: 0 ;FILE NAME.
EXTION: 0 ;EXTENSION.
0
PPPN: 0 ;PROJECT-PROGRAMMER.
SUBR(TVDSKI) INPUT TV PICTURE FROM DISK FILE.
BEGIN TVDSKI;-----------------------------------------------------
EXTERN SKY
JRST L1
JRST L1A
L1: OUTSTR[ASCIZ/ PICTURE FILE: /]
CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DAT/])↔POP0J
L1A: INIT 1,17↔SIXBIT/DSK/↔0↔HALT
LOOKUP 1,FILNAM↔GO L1
CALL(SEGTV)
SETZM FTVHIS
MOVS PPPN↔MOVMS ;GET FILE SIZE.
CAIN 24400↔GO L2
PUSHP 0
ADDI SKY
CORE2
GO [ FATAL(CAN'T GET MORE UPPER SEGMENT CORE) ]
POPP 0
SUBI 200↔DACN
DIP DUMP2+1
IN 1,DUMP2↔JFCL ;NON-STANDARD SIZE.
CALL(TVPACK)
MOVEI SKY-1
CORE2
GO [ FATAL(CAN'T SHRINK UPPER) ]
GO L4
L2: IN 1,DUMP1↔JFCL ;216 x 288 STANDARD SIZE.
L4: OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,↔POP0J
DUMP1: IOWD 200,HEADER
IOWD 24200,TVBUF↔0
DUMP2: IOWD 200,HEADER
IOWD 24200,SKY↔0
BEND TVDSKI; BGB 6 DECEMBER 1972 ---------------------------------
COMMENT ⊗
SUBR(TVDSKI)------------------------------------------------------
BEGIN TVDSKI;INPUT TV PICTURE FROM A DISK FILE - BGB 6 DEC 72.
OUTSTR[ASCIZ/ PICTURE FILE: /]
CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DAT/])↔POP0J
CALL(SEGTV)
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
LOOKUP 1,FILNAM↔GO[OUTSTR[ASCIZ/ LOOKUP FAILED.
/]↔GO .+4]
IN 1,DUMARG↔JFCL
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,
POP0J
DUMARG: IOWD 24400,HEADER↔0
BEND;12/14/72-----------------------------------------------------
⊗;
SUBR(TVPACK). PACK TVBUF WITH PICTURE FROM SKY ARRAY.
BEGIN TVPACK;-----------------------------------------------------
ACCUMULATORS{B,R1,C1,R2,C2,Q0,Q1,Q2}
SETO↔CAME HEADER↔POP0J
LAC HEADER+1↔DAC BYTSIZ#
LAC HEADER+2↔DAC WWIDTH#
LAC HEADER+4↔SUB HEADER+3↔AOS↔DAC MROWS#↔LSH -1↔DAC HALFM#
LAC HEADER+6↔SUB HEADER+5↔AOS↔DAC NCOLS#↔LSH -1↔DAC HALFN#
LAC R2,HALFM↔SUBI R2,=108
LAC Q0,R2↔IMUL Q0,WWIDTH
ADDI Q0,SKY↔CDR 0,HEADER+7↔SUBI 0,200↔ADD Q0,0
LAC Q2,[POINT 6,TVBUF,-1]
SETZ R1,
L0: SETZ C1,↔LAC C2,HALFN↔SUBI C2,=144
L1: MOVE B,BACKGROUND
SKIPL R2↔CAML R2,MROWS↔GO L2
SKIPL C2↔CAML C2,NCOLS↔GO L2
TLNN Q0,-1↔CALL(L3)
ILDB B,Q1
LSH B,0
L2: IDPB B,Q2
AOS C2↔AOS C1↔CAIE C1,=288↔GO L1
ADD Q0,WWIDTH↔LAC Q1,Q0
AOS R2↔AOS R1↔CAIE R1,=216↔GO L0
POP0J
L3: LAC 0,C2↔IDIV 0,BYTSIZ↔ADD Q0,0 ;WORD.
IMUL 1,BYTSIZ↔LACI 0,=36↔SUB 0,1 ;P-BITS.
LSH 0,6↔IOR 0,BYTSIZ↔ROT 0,-=12 ;S-BITS.
IOR Q0,0↔LAC Q1,Q0
LACI 6↔SUB BYTSIZ↔DAP L2-1
POP0J
BEND TVPACK; BGB 18 APRIL 1973 -----------------------------------
INTERNAL BACKGROUND
BACKGROUD: -1
SUBR(TVDSKO) INPUT TV PICTURE FROM A DISK FILE.
BEGIN TVDSKO;-----------------------------------------------------
OUTSTR[ASCIZ/ PICTURE FILE: /]
CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DAT/])↔POP0J
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
ENTER 1,FILNAM↔GO[OUTSTR[ASCIZ/ ENTER FAILED.
/]↔GO .+4]
CALL(SEGTV)
LAC[XWD HEADER,HEADER+1]↔SETZM HEADER↔BLT HEADER+177
LAC[XWD HEAD1,HEADER]↔BLT HEADER+7
OUT 1,DUMARG↔JFCL
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,↔POP0J
HEAD1: -1
6 ; BITS PER BYTE.
=48 ;WORDS PER LINE.
=20 ;FIRST AND LAST ROW.
=235
=28
=315 ;FIRST AND LAST COL.
XWD -=10368,200
DUMARG: IOWD 24400,HEADER↔0
BEND TVDSKO; BGB 6 DECEMBER 1973 ---------------------------------
COMMENT ⊗
SUBR(TVDSKO)------------------------------------------------------
BEGIN TVDSKO;INPUT TV PICTURE FROM A DISK FILE - BGB 6 DEC 72.
OUTSTR[ASCIZ/ PICTURE FILE: /]
CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DAT/])↔POP0J
CALL(SEGTV)
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
ENTER 1,FILNAM↔GO[OUTSTR[ASCIZ/ ENTER FAILED.
/]↔GO .+4]
OUT 1,DUMARG↔JFCL
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,
POP0J
DUMARG: IOWD 24400,HEADER↔0
BEND;12/14/72-----------------------------------------------------
⊗;
SUBR(PLOTO)-------------------------------------------------------
BEGIN PLOTO;DISPLAY BUFFER TO DISK FILE - BGB 10 DEC 1972.
CALL(DPYIMG)↔EXTERN DPYIMG
OUTSTR[ASCIZ/ PLOT FILE: /]
CALL(GETFIL,[SIXBIT/PLT/],[SIXBIT/DAT/])↔POP0J
MOVE 1,DPYBUF↔MOVN(1)1↔SUBI 2
HRRZ 2,(1)↔SETZM 1(2)
MOVS↔HRRI -1(1)↔MOVEM DUMLST
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
ENTER 1,FILNAM↔GO .+4
OUT 1,DUMLST↔JFCL
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,
POP0J
DUMLST: 0↔0
BEND;12/10/72------------------------------------------------------
SUBR(TVXGP)-------------------------------------------------------
BEGIN TVXGP; VIDEO BUFFER TO XEROX GRAPHICS PRINTER.
;BGB - 19 JANUARY 1973.
;ONE TO SIXTEEN EXPANSION: 216*4=864 BY (288*4=1152 OR 32 WORDS)
;XGP BUFFER SIZE 28513 = 864 LINES * 33 WORDS PER LINE + 1.
ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2}
;EXPAND CORE FOR XGP BUFFER.
MOVE 44↔MOVEM SAV44#↔ADDI =28513↔IORI 1777
CALLI 11↔GO L4↔CALL(SEGTV)
HRRZ 1,SAV44↔SETZM(1)↔HRLM 1,1↔AOS 1↔HRRZ 2,44↔BLT 1,(2)
;PUT CONTROL WORD IN EACH ROW.
MOVE[1B11+=192B23+=32]↔MOVE 1,SAV44↔AOS 1↔MOVEI 2,=864
MOVEM(1)↔ADDI 1,=33↔SOJG 2,.-2↔MOVSI 577000↔MOVEM(1)
MOVE P1,[POINT 6,TVBUF,-1]
MOVE P2,SAV44↔ADDI P2,2
MOVEI I,=216
L1: MOVEI J,=32
L2: SETZB 0,1↔SETZB 2,3
MOVEI K,=9
;L3: ILDB Q,P1↔CAMGE Q,HCUT↔SETZ Q,↔SKIPE Q↔MOVEI Q,70
L3: ILDB Q,P1↔TRZ Q,3
ROTC 0,4↔ROTC 2,4
IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)↔IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
SOJG K,L3
MOVEM 0,=00(P2)↔MOVEM 1,=33(P2)↔MOVEM 2,=66(P2)↔MOVEM 3,=99(P2)
AOS P2
SOJG J,L2
ADDI P2,=100
SOJG I,L1
DETSEG
;GRAB THE DEVICE.
INIT 1,17↔SIXBIT/XGP/↔0↔GO[OUTSTR[
ASCIZ/ CAN'T INIT XGP.
/]↔ POP0J]
MOVE SAV44↔HRRM DUMARG+1
LOCK
OUTSTR[ASCIZ/OUTPUTING TO XGP.../]
OUT 1,DUMARG↔RELEASE 1,
UNLOCK
OUTSTR[ASCIZ/FINISHED.
/]
MOVE SAV44↔CALLI 11
L4: OUTSTR[ASCIZ/ NOT ENUF CORE FOR XGP BUFFER.
/]↔ CRLF↔POP0J
DUMARG: XWD -2,[1B0↔030000000000]-1
XWD -=28513,0
0
;-----TVXGP - HALF TONE TABLE.
INTERNAL HTT
↑HTT:
COMMENT ⊗;
00↔17↔17↔00 ; 2 LINES HORIZONTAL TOGETHER. 0
00↔17↔00↔17 ; 2 LINES HORIZONTAL 1
06↔06↔06↔06 ; 2 LINES VERTICAL TOGETHER 2
00↔07↔07↔07 ; 9 DOTS TOGETHER 3
11↔06↔06↔11 ; BOTH DIAGONAL 4
00↔17↔07↔00 ; 8 DOTS TOGETHER 5
00↔00↔07↔07 ; 6 DOTS TOGETHER 6
00↔06↔06↔00 ; 4 DOTS TOGETHER 7
17↔00↔00↔00 ; 1 LINE HORIZONTAL 10
10↔10↔10↔10 ; 1 LINE VERTICAL 11
10↔04↔02↔01 ; 1 LINE DIAGONAL 12
00↔07↔00↔00 ; 3 DOTS TOGETHER 13
00↔03↔00↔00 ; 2 DOTS TOGETHER 14
00↔01↔00↔10 ; 2 DOTS APART 15
00↔01↔00↔00 ; 1 DOT 16
00↔00↔00↔00 ; NOTHING. 17
⊗;
;NEW HALF TONE TABLE
6 ↔ 7 ↔ 7 ↔ 6
6 ↔ 6 ↔ 7 ↔ 6
6 ↔ 6 ↔ 6 ↔ 6
6 ↔ 6 ↔ 6 ↔ 6
6 ↔ 6 ↔ 6 ↔ 4
4 ↔ 6 ↔ 6 ↔ 4
4 ↔ 6 ↔ 6 ↔ 4
4 ↔ 4 ↔ 6 ↔ 4
4 ↔ 4 ↔ 4 ↔ 4
4 ↔ 4 ↔ 4 ↔ 4
0 ↔ 4 ↔ 4 ↔ 4
4 ↔ 4 ↔ 4 ↔ 0
0 ↔ 4 ↔ 4 ↔ 0
0 ↔ 0 ↔ 4 ↔ 0
0 ↔ 0 ↔ 4 ↔ 0
0 ↔ 0 ↔ 0 ↔ 0
BEND;1/19/73-------------------------------------------------------
SUBR(CREOUT)------------------------------------------------------
BEGIN CREOUT; CONTOUR,REGION,EDGE FILE FORMAT OUTPUT.
;BGB - 6 DECEMBER 1972.
MOVE 2,BUCKY
GO @[TVDSKO↔.+1↔NEWOUT↔FONTO](2)
COMMENT ⊗
MOVE CTRL↔AND META↔SKIPE↔GO FONTO
SKIPN CTRL↔GO TVDSKO
SKIPE META↔GO[OUTSTR[ASCIZ/??? /]↔POP0J]
⊗;
OUTSTR[ASCIZ/ CRE FILE: /]
CALL(GETFIL,[SIXBIT/CRE/],[SIXBIT/FNT/])↔POP0J
CALL(SHRINK)
MOVN FILM↔CALL(RELLOC,0)
;SETUP DUMP OUT ARGUMENT IOWD.
MOVE FILM↔SUB@AVAIL
MOVM 1,0↔MOVSS
HRR OLD44↔MOVEM OUTARG
MOVE@FILM↔MOVEM TMP#↔MOVEM 1,@FILM ;FILE SIZE IN WORDS.
;FILE OUTPUT RITUAL.
MOVE@AVAIL↔SUB FILM↔MOVEM@AVAIL
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
ENTER 1,FILNAM
GO[OUTSTR[ASCIZ/ ENTER FAILED.
/]↔GO .+4]
OUT 1,OUTARG↔JFCL
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,
SETZM FILNAM↔SETZ EXTION↔SETZM EXTION+1↔SETZM PPPN
CALL(RELLOC,FILM)
MOVE TMP↔MOVEM@FILM
MOVE@AVAIL↔ADD FILM↔MOVEM@AVAIL
POP0J
OUTARG: 0↔0
BEND;1/28/73------------------------------------------------------
SUBR(CREIN)-------------------------------------------------------
BEGIN CREIN; CONTOUR,REGION,EDGE FILE FORMAT INPUT.
;BGB - 28 JANURAY 1973.
MOVE 2,BUCKY
GO @[TVDSKI↔.+1↔NEWIN↔FONTI](2)
COMMENT ⊗
MOVE CTRL↔AND META↔SKIPE↔GO FONTI
SKIPE META↔GO[OUTSTR[ASCIZ/??? /]↔POP0J]
SKIPN CTRL↔GO TVDSKI
⊗;
OUTSTR[ASCIZ/ CRE FILE: /]
CALL(GETFIL,[SIXBIT/CRE/],[SIXBIT/FNT/])↔POP0J
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
LOOKUP 1,FILNAM↔GO [ OUTSTR[ASCIZ/FILE NOT FOUND.
/]↔ POP0J]
SETZM QBLK
MOVE PPPN↔HRR FILM↔SOS↔MOVEM INARG ;IOWD
MOVS PPPN↔MOVMS↔ADD FILM
IORI 1777↔CAMG 44↔GO L1
CALLI 11↔HALT
MOVE 44↔AOS↔SUB FILM↔DIVI 7↔MOVEM 1,REMAINDER
L1: IN 1,INARG
RELEASE 1,
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,
SETZM FILNAM↔SETZM EXTION↔SETZM EXTION+1↔SETZM PPPN
HRRZ@AVAIL↔ADD FILM↔MOVEM@AVAIL↔SETZM@
HRLM↔AOS↔MOVE 1,44↔BLT(1) ;CLEAR EMPTY AREA.
CALL(RELLOC,FILM)
;RESET AVAIL LIST.
MOVE 1,@AVAIL↔MOVE 2,44
HRLI 1,NODSIZ(1)↔GO L6
L5: HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
L6: CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L5
SUBI 2,NODSIZ-1(1)↔MOVEM 2,REMAINDER
CALL(DPYIMG)
POP0J
INARG: 0↔0
BEND;1/28/73------------------------------------------------------
SUBR(FONTI)-------------------------------------------------------
BEGIN FONTI;FONT FILE INPUT - BGB - 1 FEBRUARY 1973.
EXTERN ORGPTR,ENDPTR
CALL(SEGFNT)↔OUTSTR[ASCIZ/ FONT FILE: /]
CALL(GETFIL,[SIXBIT/FNT/],[SIXBIT/FNT/])↔POP0J
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
LOOKUP 1,FILNAM
GO [ OUTSTR[ASCIZ/FILE NOT FOUND.
/]↔ POP0J ]
MOVE PPPN↔HRRI $↔SOS↔MOVEM INARG ;IOWD.
MOVS PPPN↔MOVMS↔ADDI $↔CORE2↔HALT ;MAKE UPPER SEG.
MOVE[SIXBIT/FNTSEG/]↔CALLI $+36↔JFCL ;NAME UPPER SEG.
IN 1,[INARG:0↔0]
RELEASE 1,
MOVEI 3,400 ;FIND END OF FONT
MOVSI 1,-200
L1: SKIPLE 2,$(1)
CAILE 3,(2)
JRST .+2
HRRZ 3,2
AOBJN 1,L1
ADD 3,(3)
ADDI 3,$
HRRZM 3,ORGPTR
ORI 3,1777
HRRZM 3,ENDPTR
POP0J
BEND;2/1/73-------------------------------------------------------
SUBR(FONTO)-------------------------------------------------------
BEGIN FONTO;FONT FILE OUTPUT - BGB - 1 FEBRUARY 1973.
CALL(SEGFNT)↔OUTSTR[ASCIZ/ FONT FILE: /]
CALL(GETFIL,[SIXBIT/FNT/],[SIXBIT/FNT/])↔POP0J
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
ENTER 1,FILNAM↔GO [ OUTSTR[ASCIZ/FILE PROTECTED OR IN USE.
/]↔ POP0J ]
CALL(OFIXFNT)
MOVE ORGPTR↔SUBI $-1↔MOVNS↔HRLM OUTARG ;SETUP IOWD
MOVEI $-1↔HRRM OUTARG
OUT 1,OUTARG
RELEASE 1,
POP0J
OUTARG: 0↔0
BEND;2/1/73-------------------------------------------------------
NSUBR(OFIXFNT)
;PREPARE FONT FOR OUTPUT
ACCUMULATORS{ADR,T1,T2,CHAR,BMIN,HMAX}
WMAX←$+202
SETZB HMAX,WMAX
MOVEI BMIN,377777
MOVE CHAR,[XWD -200,$]
FL1: SKIPG ADR,(CHAR) ;FIND MIN. TOP COUNT AND MAX. HEIGHT
JUMPLE ADR,FNDF
HLRE T1,(CHAR)
CAMLE T1,WMAX
MOVEM T1,WMAX
HLRE T1,$+1(ADR) ;GET TOP COUNT
JUMPL T1,[FATAL(NEGATIVE TOP COUNT)]
CAMGE T1,BMIN ;SMALLEST?
MOVEM T1,BMIN ;YES
HRRE T2,$+1(ADR) ;GET DATA COUNT
JUMPL T1,[FATAL(NEGATIVE DATA COUNT)]
ADD T2,T1 ;ADD TOP COUNT
CAMLE T2,HMAX ;LARGEST CHARACTER HEIGHT?
MOVEM T2,HMAX ;YES
FNDF: AOBJN CHAR,FL1 ;LOOP FOR EACH CHARACTER
MOVEI =108 ;NORMAL BASE LINE
MOVEM $+203
MOVNS BMIN
ADDM BMIN,$+203 ;NEW BASE LINE
ADD HMAX,BMIN
MOVEM HMAX,$+201 ;SET MAX. HEIGHT
HRLZ BMIN,BMIN ;MOVE INTO LEFT HALF
MOVE CHAR,[XWD -200,$]
FL2: SKIPLE ADR,(CHAR) ;NOW UPDATE BASE LINE ON EACH CHARACTER
ADDM BMIN,$+1(ADR)
AOBJN CHAR,FL2
POP0J
SUBREND OFIXFNT;
SUBR(RELLOC)BASE--------------------------------------------------
BEGIN RELLOC;RELOCATE ALL POINTERS - BGB - 6 DECEMBER 1972.
ACCUMULATORS{A,B,C,D}
DEFINE KAR(Q){HLRZ Q(A)↔SKIPE↔ADD B↔HRLM Q(A)↔GO .+1}
DEFINE KDR(Q){HRRZ Q(A)↔SKIPE↔ADD B↔HRRM Q(A)↔GO .+1}
MOVE B,ARG1 ;BASE ADDRESS.
MOVE A,FILM ;BLOCK POINTER.
L1: SKIPN(A)2↔GO[KDR 0↔GO L2] ;EMPTY BLOCK.
RELOC D,A↔TRNE D,400000↔MOVEI D,333333
TRNE D,200000↔GO[KAR 0]↔ TRNE D,100000↔GO[KDR 0]
TRNE D,20000 ↔GO[KAR 1]↔ TRNE D,10000 ↔GO[KDR 1]
TRNE D,2000 ↔GO[KAR 3]↔ TRNE D,1000 ↔GO[KDR 3]
TRNE D,200 ↔GO[KAR 4]↔ TRNE D,100 ↔GO[KDR 4]
TRNE D,20 ↔GO[KAR 5]↔ TRNE D,10 ↔GO[KDR 5]
TRNE D,2 ↔GO[KAR 6]↔ TRNE D,1 ↔GO[KDR 6]
L2: ADDI A,7+7↔CAML A,44↔POP1J
SUBI A,7
GO L1
LIT
BEND;12/20/72-----------------------------------------------------
SUBR(TVIN4)------------------------------------------------------
BEGIN TVIN4; FOUR BIT TELEVISION INPUT - BGB - 14 DEC 1972.
L0: DETSEG ;$%$%#&#&# SYSTEM
INIT 17,1017↔SIXBIT/TV/↔0
GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
L0A: SETSTS 17,17
SETZM TVERR↔INPUT 17,TVPTR↔RELEASE 17,
;REPORT ON THE ERROR BITS AND RETAKE IF NECESSARY;
MOVE 1,TVERR
TRNE 1,100000↔OUTSTR[ASCIZ/V PARITY ERROR.
T/]↔ TRNE 1,40 ↔OUTSTR[ASCIZ/V DATA MISS.
T/]↔ TRNE 1,20 ↔OUTSTR[ASCIZ/V NON EX MEM.
T/]↔ TRNE 1,100060↔JRST L0
SKIPN META↔OUTSTR[ASCIZ/AKEN.
/]
CALLI 22↔MOVEM TVTIME#
CALLI 14↔MOVEM TVDATE#
CALL(SEGTV)
MOVE[XWD HISTO,HISTO+1]↔SETZM HISTO↔BLT HISTO+77
SETZM FTVSIX↔SETOM FTVHIS
;CONVERT FROM GREY CODE TO GRAY CODE.
MOVE 16,[XWD L,0]↔BLT 16,12
HRR TVPTR↔GO 4
L: POINT 4,0,-1↔ FROM←←0
POINT 6,TVBUF,-1↔ TO←←1
=62208 ↔ CNT←←2
0 ↔ BYT←←3
ILDB BYT,FROM ;4
MOVE BYT,GRAY(BYT) ;3
LSH BYT,2 ;6
AOS HISTO(BYT) ;7
IDPB BYT,TO ;8
SOJG CNT,4 ;9
POP0J ;12
BEND;12/16/72-----------------------------------------------------
TVPTR: XWD -=6912,0
TVCLIP: 703002 ;BCLIP=7 TCLIP=0 CAM=3.
TVYXW: BYTE(9)50,34,40
TVERR: 0
GRAY: OCT 12,13,11,10,15,14,16,17,5,4,6,7,2,3,1,0
SUBR(TVIN6)------------------------------------------------------
BEGIN TVIN6; SIX BIT TELEVISION INPUT - BGB - 14 DEC 1972.
L0: DETSEG
INIT 17,1017↔SIXBIT/TV/↔0
GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
L0A: SETSTS 17,17
SETZM TVERR6#↔PUSH P,TVCLIP
MOVEI 76↔DPB[POINT 6,TVCLIP,23]
MOVE TVPTR↔LIPI 440400↔MOVEM P1#
L1: SETZM TVERR↔INPUT 17,TVPTR↔MOVE TVERR
IORM TVERR6↔TRNE 100060↔GO L1
MOVEI 54↔DPB[POINT 6,TVCLIP,23]
MOVEI =6912↔ADDB TVPTR↔LIPI 440400↔MOVEM P2#
L2: SETZM TVERR↔INPUT 17,TVPTR↔MOVE TVERR
IORM TVERR6↔TRNE 100060↔GO L2
MOVEI 32↔DPB[POINT 6,TVCLIP,23]
MOVEI =6912↔ADDB TVPTR↔LIPI 440400↔MOVEM P3#
L3: SETZM TVERR↔INPUT 17,TVPTR↔MOVE TVERR
IORM TVERR6↔TRNE 100060↔GO L3
MOVEI 10↔DPB[POINT 6,TVCLIP,23]
MOVEI =6912↔ADDB TVPTR↔LIPI 440400↔MOVEM P4#
L4: SETZM TVERR↔INPUT 17,TVPTR↔MOVE TVERR
IORM TVERR6↔TRNE 100060↔GO L4
POP P,TVCLIP
;REPORT ON THE ERROR BITS.
MOVE 1,TVERR6
TRNE 1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
/]↔ TRNE 1,40 ↔OUTSTR[ASCIZ/TV DATA MISS.
/]↔ TRNE 1,20 ↔OUTSTR[ASCIZ/TV NON EX MEM.
/]↔ TRNE 1,100060↔GO L0A ;RETRY
OUTSTR[ASCIZ/AKEN
/]↔ RELEASE 17,
CALLI 22↔MOVEM TVTIME#
CALLI 14↔MOVEM TVDATE#
CALL(SEGTV)
MOVE[XWD HISTO,HISTO+1]↔SETZM HISTO↔BLT HISTO+77
SETOM FTVSIX↔SETOM FTVHIS↔AOS(P);SKIP !!
;CONVERT FROM GREY CODE TO GRAY CODE.
MOVE[POINT 6,TVBUF,-1]↔MOVEM P5#
MOVE[XWD L,3]↔BLT 16↔MOVEI =62208
GO 3
;SIX BIT AC-LOOP.
L: ILDB 1,P1↔MOVE 2,GRAY(1)
ILDB 1,P2↔ADD 2,GRAY(1)
ILDB 1,P3↔ADD 2,GRAY(1)
ILDB 1,P4↔ADD 2,GRAY(1)
IDPB 2,P5↔AOS HISTO(2)
SOJG 0,3↔POP0J
BEND;12/16/72-----------------------------------------------------
SUBR(TVCAMI)------------------------------------------------------
BEGIN TVCAMI;TELEVISION CAMERA INPUT - BGB - 14 DEC 1972.
MOVE 44↔MOVEM TMP44#↔AOS↔HRRM TVPTR
ADDI =6912↔SKIPE CTRL↔ADDI 3*=6912
CALLI 11↔GO[FATAL(NO CORE FOR TVTAKE.)]
; CALL(SEGTV)
; MOVE[XWD TVBUF,TVBUF+1]
; SETZM TVBUF↔BLT TVBUF+=10367
SKIPE META↔GO AUTO
SKIPE CTRL↔CALL(TVIN6)↔CALL(TVIN4)
AUTO4: MOVE TMP44↔CALLI 11↔JFCL
DETSEG↔CRLF↔POP0J
AUTO: PUSH P,TVCLIP
MOVEI 70
DPB [POINT 6,TVCLIP,23]
CALL(TVIN4)
MOVSI 1,-100 ;SET LOWER CLIP LEVEL
AUTO1: MOVE 0,HISTO(1) ;GET NUMBER OF POINTS
CAML 0,LOWMAX ;LESS THAN MAX.
GO [ HRRZ 1,1 ;NO, THIS IS MUST BE IN IMAGE. FLUSH WORD COUNT PART
ASH 1,-3 ;FROM 0-7
MOVEI 0,7 ;SUBTRACTED FROM 7
SUB 0,1
DPB [POINT 3,TVCLIP,20]
ADDI 0,"0"
OUTSTR[ASCIZ/ BCLIP = /]
OUTCHR 0
MOVEI 1,77 ;SET UPPER CLIP LEVEL
GO AUTO2 ]
AOBJN 1,AUTO1
AUTERR: FATAL(AUTO-CLIPPING LOST)
AUTO2: MOVE 0,HISTO(1) ;GET NUMBER OF POINTS
CAML 0,HIMAX ;LESS THAN MAX.
GO [ ASH 1,-3 ;;NO, THIS IS MUST BE IN IMAGE. CVT TO FROM 0-7
MOVEI 0,7
SUB 0,1
DPB 0,[POINT 3,TVCLIP,23]
ADDI 0,"0"
OUTSTR[ASCIZ/, TCLIP = /]
OUTCHR 0
OUTSTR[ASCIZ/
T/]
GO AUTO3 ]
SOJG 1,AUTO2
GO AUTERR
AUTO3: SETZM META
CALL(TVIN4)
POP P,TVCLIP
GO AUTO4
BEND;12/16/72-----------------------------------------------------
LOWMAX: 40 ;MAXIMUM NUMBER OF POINTS CONSIDERED TO BE NEGLIGABLE IN CLIP SETTING
HIMAX: 40 ;(FOR TOP END)
SUBR(CAMERA)------------------------------------------------------
BEGIN CAMERA
OUTSTR[ASCIZ/ CAMERA (CURRENTLY /]
LDB 0,[POINT 3,TVCLIP,26]
ADDI 0,"0"
OUTCHR 0
OUTSTR[ASCIZ/): /]
INCHRW
CAIL "0"
CAIG "3"
GO [ OUTSTR[ASCIZ/???
/]↔ POP0J]
ANDI 3
LSH 9
IORI 700002
MOVEM TVCLIP
CRLF
POP0J
BEND;12/6/72------------------------------------------------------
NSUBR NEWIN
;Format:
;
;Character header
; CHAR_CODE
; WIDTH
;List of polygons terminated by -1 in each character header in form
; XWD TYPE,RELOC
;List of vertices terminated by -1 in each polygon in form:
; XWD ROW,COL
;
;Zeros are ignored
ACCUMULATORS{T1,T2,T3,IMG,LVL,PGN,V,IMG0,LVL0,PGN0,V0}
OUTSTR[ASCIZ/ CRUNCHED FILE = /]
CALL(GETFIL,[SIXBIT/POL/],[SIXBIT/FNT/])↔POP0J
SETZM IHDR
INIT 10
SIXBIT/DSK/
XWD 0,IHDR
GO [ FATAL(CAN'T INIT DSK) ]
LOOKUP FILNAM
GO [ RELEASE
OUTSTR[ASCIZ/FILE NOT FOUND.
/]↔ POP0J ]
SETZM META
SETZM CTRL
CALL(KILLER)
JSP BGBFIO
ILOOP: CALL(WORDIN)↔GO FININ
JUMPE 1,ILOOP
PUSHP 1
SETQ IMG,{MKIMAG,FILM}
SETQ LVL,{MKLEVL,IMG,0}
POPP 1
NCNT. 1,LVL
CALL(WORDIN)↔GO UNEXPECTED
PGON. 1,LVL
PLOOP: CALL(WORDIN)↔GO UNEXPECTED
JUMPL 1,ILOOP
SETQ PGN,{MAKE,1}
DAD. LVL,PGN
CALL(RINGIN,PGN,LVL)
VLOOP: CALL(WORDIN)↔GO UNEXPECTED
JUMPL 1,PLOOP
PUSHP 1
SETQ V,{MAKE,[VBIT+VREL]}
POPP 1(V)
PGON. PGN,V
CALL(RINGIN,V,PGN)
GO VLOOP
FININ: RELEASE
OUTSTR[ASCIZ/ EOF.
/]↔ JSP FNBFIO
CALL(DPYIMG)
POP0J
NSUBR WORDIN
SOSG IHDR+2
IN
GO [ ILDB 1,IHDR+1↔AOS(P)↔POP0J]
STATZ IODEND
POP0J
RELEASE
JSP FNBFIO
FATAL(READ ERROR)
SUBREND WORDIN
IHDR: BLOCK 3
UNEXPECTED: JSP FNBFIO
FATAL(UNEXPECTED END OF FILE)
SUBREND NEWIN
NSUBR NEWOUT
ACCUMULATORS{IMG,LVL,PGN,V,IMG0,LVL0,PGN0,V0}
OUTSTR[ASCIZ/ CRUNCHED FILE = /]
CALL(GETFIL,[SIXBIT/POL/],[SIXBIT/FNT/])↔POP0J
MOVE 1,FILM
SON IMG,1
JUMPE IMG,[OUTSTR[ASCIZ/NOTHING THERE!
/]↔ POP0J]
SETZM OHDR
INIT 10
SIXBIT/DSK/
XWD OHDR,0
GO [ FATAL(CAN'T INIT DSK) ]
ENTER FILNAM
GO [ RELEASE
OUTSTR[ASCIZ/FILE IN USE OR PROTECTED
/]↔ POP0J ]
CW IMG,IMG ;SO THAT FIRST IMAGE IS SHOWN BY NEWIN
MOVEM IMG,IMG0
JSP BGBFIO
SETZ 0,
ILOOP: SON LVL,IMG
JUMPE LVL,ICONT
MOVEM LVL,LVL0
LLOOP: CALL(WORDOUT,<4(LVL)>)
CALL(WORDOUT,<5(LVL)>)
SON PGN,LVL
JUMPE PGN,LCONT
MOVEM PGN,PGN0
PLOOP: CALL(WORDOUT,<2(PGN)>)
SON V,PGN
JUMPE V,PCONT
MOVEM V,V0
VLOOP: SOSG OHDR+2
OUT
GO VCONT
JSP FNBFIO
FATAL(WRITE ERROR)
VCONT: MOVE 1,1(V)
IDPB 1,OHDR+1
CCW V,V
JUMPE V,[FATAL(DISCONNECTED VERTEX RING!)]
CAME V,V0
GO VLOOP
PCONT: CALL(WORDOUT,[-1])
CCW PGN,PGN
CAME PGN,PGN0
GO PLOOP
LCONT: CALL(WORDOUT,[-1])
CCW LVL,LVL
CAME LVL,LVL0
GO LLOOP
ICONT: CW IMG,IMG ;SO IMAGES COME BACK IN THE SAME ORDER
CAME IMG,IMG0
GO ILOOP
RELEASE
OUTSTR[ASCIZ/ EOF.
/]↔ JSP FNBFIO
POP0J
↑BGBFIO: MOVE 1,[XWD -4,BFSAVE-1]
FOR I⊂(JOBSA,JOBREN,JOBFF)
< PUSH 1,I
>
MOVE 1,DPYBUF
HRRM 1,JOBFF
MOVEI 1,[JSP FNBFIO↔JRST SA]
MOVEM 1,JOBREN
HRRM 1,JOBSA
JRSTF @0
↑FNBFIO: MOVE 1,[XWD -1,BFSAVE+2]
FOR I⊂(JOBFF,JOBREN,JOBSA)
< POP 1,I
>
JRSTF @0
BFSAVE: BLOCK 3
NSUBR WORDOUT,ARG
SOSG OHDR+2
OUT
GO [ EXCH 1,ARG↔IDPB 1,OHDR+1↔EXCH 1,ARG↔POP1J]
RESET
JSP FNBFIO
FATAL(WRITE ERROR!)
SUBREND WORDOUT
OHDR: BLOCK 3
SUBREND NEWOUT
TAIL
END SA